-- CIS 552, Mini-project
-- by Mike Gottlieb and Reilly Grant

-- |Representation of the deck.  Since there should only be one deck, operations
--  which modify the deck return the resulting deck as well.
module Deck (T, -- type
             deck, -- constructor
             pick, deal, shuffle, -- functions modifying type
             test -- tests
            ) where

import qualified Card
import Control.Monad.ST
import Test.HUnit hiding (test)
import Random
import Util

data T = Deck [Card.T]
       deriving (Show, Eq)

-- |Constructs a deck with all 52 cards.
deck :: T
deck = Deck [Card.card suit rank | suit <- [Card.Heart ..], rank <- [2..14]]

-- |Shuffle's the deck, bridging the deck 7 times has been shown to provide
--  adequate randomness.
shuffle :: T -> IO T
shuffle (Deck d) = do d0 <- shuffle' d
                      d1 <- shuffle' d0
                      d2 <- shuffle' d1
                      d3 <- shuffle' d2
                      d4 <- shuffle' d3
                      d5 <- shuffle' d4
                      d6 <- shuffle' d5
                      return (Deck d6)
    where shuffle' [] = return []
          shuffle' d = do let midpoint = length d `div` 2
                              (a, b) = splitAt midpoint d
                          cards <- bridge a b
                          return cards

-- |Perform one bridge operation, this type of shuffling translates nicely
--  into a functional recursive implementation.
bridge :: [Card.T] -> [Card.T] -> IO [Card.T]
bridge [] [] = return []
bridge a []  = return a
bridge [] b  = return b
bridge a@(a':as) b@(b':bs) = 
    do flip <- randomIO
       if flip 
         then do rest <- bridge as b
                 return (a' : rest)
         else do rest <- bridge a bs
                 return (b' : rest)

-- |Pick one card from the deck, return the resulting deck.
pick :: T -> (Card.T, T)
pick (Deck []) = error "Deck is empty"
pick (Deck (c:cs)) = (c, Deck cs)

-- |Pick n cards from the deck, return the resulting deck.
deal :: Int -> T -> ([Card.T], T)
deal 0 d = ([], d)
deal n d = (c : cs, rest2)
           where (c, rest1) = pick d
                 (cs, rest2) = deal (n-1) rest1

-- |Number of cards left in the deck.
size :: T -> Int
size (Deck cs)  = length cs


-- |Verify there are 13 cards of each suit.
verifySuits :: T -> Bool
verifySuits d = and $ map (helper d) [Card.Heart .. ]
    where helper (Deck cs) s = countWith ((s==) . Card.suit) cs == 13 

-- |Verify there are 4 cards of each rank.
verifyRanks :: T -> Bool
verifyRanks d = and $ map (helper d) [2..14]
    where helper (Deck cs) r = countWith ((r==) . Card.rank) cs == 4

-- |Verify the deck contains 52 cards, 4 of each rank and 13 of each suit.
verifyDeck :: T -> Bool
verifyDeck d = verifySuits d && verifyRanks d && size d == 52

-- |Check a newly constructed deck is correct.
test_legit = TestCase (let d = deck in
                       assertBool "legal deck" (verifyDeck d))

-- |Check a shuffled deck is still correct.
test_shuffle = TestCase (let d = deck in
                         do x <- shuffle d
                            assertBool "shuffle deck" (verifyDeck x))

-- |Replace a card into the deck (for testing purposes only).
replaceCard :: Card.T -> T -> T
replaceCard c (Deck cs) = Deck (c:cs)

-- |Check that picking a card and then replacing it still yields a valid deck.
test_deal = TestCase (let d = deck in
                      do x <- shuffle d
                         let (c, rest) = pick x
                             cards = replaceCard c rest
                         assertBool "deal deck" (verifyDeck cards))

tests = TestList [test_legit, test_shuffle, test_deal]

-- |Run all deck test cases.                             
test = runTestTT tests
